home *** CD-ROM | disk | FTP | other *** search
/ Supercompiler 1997 / SUPERCOMPILER97.iso / Delphi 3.0 / DATA.Z / CHLSTMPL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-30  |  8.9 KB  |  342 lines

  1. unit ChLstmpl;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, ActiveX, Classes, Controls, Graphics, Menus, Forms, StdCtrls,
  7.   ComServ, StdVCL, AXCtrls, DelLib, checklst;
  8.  
  9. type
  10.   TCheckListBoxX = class(TActiveXControl, ICheckListBoxX)
  11.   private
  12.     { Private declarations }
  13.     FDelphiControl: TCheckListBox;
  14.     FEvents: ICheckListBoxXEvents;
  15.     procedure ClickCheckEvent(Sender: TObject);
  16.     procedure ClickEvent(Sender: TObject);
  17.     procedure DblClickEvent(Sender: TObject);
  18.     procedure KeyPressEvent(Sender: TObject; var Key: Char);
  19.   protected
  20.     { Protected declarations }
  21.     procedure InitializeControl; override;
  22.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  23.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  24.     function Get_AllowGrayed: WordBool; safecall;
  25.     function Get_Color: TColor; safecall;
  26.     function Get_Columns: Integer; safecall;
  27.     function Get_Ctl3D: WordBool; safecall;
  28.     function Get_Cursor: Smallint; safecall;
  29.     function Get_DragCursor: Smallint; safecall;
  30.     function Get_Enabled: WordBool; safecall;
  31.     function Get_Font: Font; safecall;
  32.     function Get_ImeMode: TxImeMode; safecall;
  33.     function Get_ImeName: WideString; safecall;
  34.     function Get_IntegralHeight: WordBool; safecall;
  35.     function Get_ItemHeight: Integer; safecall;
  36.     function Get_ItemIndex: Integer; safecall;
  37.     function Get_Items: IStrings; safecall;
  38.     function Get_ParentColor: WordBool; safecall;
  39.     function Get_SelCount: Integer; safecall;
  40.     function Get_Sorted: WordBool; safecall;
  41.     function Get_Style: TxListBoxStyle; safecall;
  42.     function Get_TabWidth: Integer; safecall;
  43.     function Get_TopIndex: Integer; safecall;
  44.     function Get_Visible: WordBool; safecall;
  45.     procedure AboutBox; safecall;
  46.     procedure Clear; safecall;
  47.     procedure Set_AllowGrayed(Value: WordBool); safecall;
  48.     procedure Set_Color(Value: TColor); safecall;
  49.     procedure Set_Columns(Value: Integer); safecall;
  50.     procedure Set_Ctl3D(Value: WordBool); safecall;
  51.     procedure Set_Cursor(Value: Smallint); safecall;
  52.     procedure Set_DragCursor(Value: Smallint); safecall;
  53.     procedure Set_Enabled(Value: WordBool); safecall;
  54.     procedure Set_Font(const Value: Font); safecall;
  55.     procedure Set_ImeMode(Value: TxImeMode); safecall;
  56.     procedure Set_ImeName(const Value: WideString); safecall;
  57.     procedure Set_IntegralHeight(Value: WordBool); safecall;
  58.     procedure Set_ItemHeight(Value: Integer); safecall;
  59.     procedure Set_ItemIndex(Value: Integer); safecall;
  60.     procedure Set_Items(const Value: IStrings); safecall;
  61.     procedure Set_ParentColor(Value: WordBool); safecall;
  62.     procedure Set_Sorted(Value: WordBool); safecall;
  63.     procedure Set_Style(Value: TxListBoxStyle); safecall;
  64.     procedure Set_TabWidth(Value: Integer); safecall;
  65.     procedure Set_TopIndex(Value: Integer); safecall;
  66.     procedure Set_Visible(Value: WordBool); safecall;
  67.   end;
  68.  
  69. implementation
  70. uses ChLstPg;
  71. { TCheckListBoxX }
  72.  
  73. procedure TCheckListBoxX.InitializeControl;
  74. begin
  75.   FDelphiControl := Control as TCheckListBox;
  76.   FDelphiControl.OnClick := ClickEvent;
  77.   FDelphiControl.OnClickCheck := ClickCheckEvent;
  78.   FDelphiControl.OnDblClick := DblClickEvent;
  79.   FDelphiControl.OnKeyPress := KeyPressEvent;
  80. end;
  81.  
  82. procedure TCheckListBoxX.EventSinkChanged(const EventSink: IUnknown);
  83. begin
  84.   FEvents := EventSink as ICheckListBoxXEvents;
  85. end;
  86.  
  87. procedure TCheckListBoxX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  88. begin
  89.   { Define property pages here.  Property pages are defined by calling
  90.     DefinePropertyPage with the class id of the page.  For example,
  91.       DefinePropertyPage(Class_CheckListBoxXPage); }
  92. end;
  93.  
  94. function TCheckListBoxX.Get_AllowGrayed: WordBool;
  95. begin
  96.   Result := FDelphiControl.AllowGrayed;
  97. end;
  98.  
  99. function TCheckListBoxX.Get_Color: TColor;
  100. begin
  101.   Result := FDelphiControl.Color;
  102. end;
  103.  
  104. function TCheckListBoxX.Get_Columns: Integer;
  105. begin
  106.   Result := FDelphiControl.Columns;
  107. end;
  108.  
  109. function TCheckListBoxX.Get_Ctl3D: WordBool;
  110. begin
  111.   Result := FDelphiControl.Ctl3D;
  112. end;
  113.  
  114. function TCheckListBoxX.Get_Cursor: Smallint;
  115. begin
  116.   Result := Smallint(FDelphiControl.Cursor);
  117. end;
  118.  
  119. function TCheckListBoxX.Get_DragCursor: Smallint;
  120. begin
  121.   Result := Smallint(FDelphiControl.DragCursor);
  122. end;
  123.  
  124. function TCheckListBoxX.Get_Enabled: WordBool;
  125. begin
  126.   Result := FDelphiControl.Enabled;
  127. end;
  128.  
  129. function TCheckListBoxX.Get_Font: Font;
  130. begin
  131.   GetOleFont(FDelphiControl.Font, Result);
  132. end;
  133.  
  134. function TCheckListBoxX.Get_ImeMode: TxImeMode;
  135. begin
  136.   Result := Ord(FDelphiControl.ImeMode);
  137. end;
  138.  
  139. function TCheckListBoxX.Get_ImeName: WideString;
  140. begin
  141.   Result := WideString(FDelphiControl.ImeName);
  142. end;
  143.  
  144. function TCheckListBoxX.Get_IntegralHeight: WordBool;
  145. begin
  146.   Result := FDelphiControl.IntegralHeight;
  147. end;
  148.  
  149. function TCheckListBoxX.Get_ItemHeight: Integer;
  150. begin
  151.   Result := FDelphiControl.ItemHeight;
  152. end;
  153.  
  154. function TCheckListBoxX.Get_ItemIndex: Integer;
  155. begin
  156.   Result := FDelphiControl.ItemIndex;
  157. end;
  158.  
  159. function TCheckListBoxX.Get_Items: IStrings;
  160. begin
  161.   GetOleStrings(FDelphiControl.Items, Result);
  162. end;
  163.  
  164. function TCheckListBoxX.Get_ParentColor: WordBool;
  165. begin
  166.   Result := FDelphiControl.ParentColor;
  167. end;
  168.  
  169. function TCheckListBoxX.Get_SelCount: Integer;
  170. begin
  171.   Result := FDelphiControl.SelCount;
  172. end;
  173.  
  174. function TCheckListBoxX.Get_Sorted: WordBool;
  175. begin
  176.   Result := FDelphiControl.Sorted;
  177. end;
  178.  
  179. function TCheckListBoxX.Get_Style: TxListBoxStyle;
  180. begin
  181.   Result := Ord(FDelphiControl.Style);
  182. end;
  183.  
  184. function TCheckListBoxX.Get_TabWidth: Integer;
  185. begin
  186.   Result := FDelphiControl.TabWidth;
  187. end;
  188.  
  189. function TCheckListBoxX.Get_TopIndex: Integer;
  190. begin
  191.   Result := FDelphiControl.TopIndex;
  192. end;
  193.  
  194. function TCheckListBoxX.Get_Visible: WordBool;
  195. begin
  196.   Result := FDelphiControl.Visible;
  197. end;
  198.  
  199. procedure TCheckListBoxX.AboutBox;
  200. begin
  201.   ShowCheckListBoxXAbout;
  202. end;
  203.  
  204. procedure TCheckListBoxX.Clear;
  205. begin
  206.  
  207. end;
  208.  
  209. procedure TCheckListBoxX.Set_AllowGrayed(Value: WordBool);
  210. begin
  211.   FDelphiControl.AllowGrayed := Value;
  212. end;
  213.  
  214. procedure TCheckListBoxX.Set_Color(Value: TColor);
  215. begin
  216.   FDelphiControl.Color := Value;
  217. end;
  218.  
  219. procedure TCheckListBoxX.Set_Columns(Value: Integer);
  220. begin
  221.   FDelphiControl.Columns := Value;
  222. end;
  223.  
  224. procedure TCheckListBoxX.Set_Ctl3D(Value: WordBool);
  225. begin
  226.   FDelphiControl.Ctl3D := Value;
  227. end;
  228.  
  229. procedure TCheckListBoxX.Set_Cursor(Value: Smallint);
  230. begin
  231.   FDelphiControl.Cursor := TCursor(Value);
  232. end;
  233.  
  234. procedure TCheckListBoxX.Set_DragCursor(Value: Smallint);
  235. begin
  236.   FDelphiControl.DragCursor := TCursor(Value);
  237. end;
  238.  
  239. procedure TCheckListBoxX.Set_Enabled(Value: WordBool);
  240. begin
  241.   FDelphiControl.Enabled := Value;
  242. end;
  243.  
  244. procedure TCheckListBoxX.Set_Font(const Value: Font);
  245. begin
  246.   SetOleFont(FDelphiControl.Font, Value);
  247. end;
  248.  
  249. procedure TCheckListBoxX.Set_ImeMode(Value: TxImeMode);
  250. begin
  251.   FDelphiControl.ImeMode := TImeMode(Value);
  252. end;
  253.  
  254. procedure TCheckListBoxX.Set_ImeName(const Value: WideString);
  255. begin
  256.   FDelphiControl.ImeName := TImeName(Value);
  257. end;
  258.  
  259. procedure TCheckListBoxX.Set_IntegralHeight(Value: WordBool);
  260. begin
  261.   FDelphiControl.IntegralHeight := Value;
  262. end;
  263.  
  264. procedure TCheckListBoxX.Set_ItemHeight(Value: Integer);
  265. begin
  266.   FDelphiControl.ItemHeight := Value;
  267. end;
  268.  
  269. procedure TCheckListBoxX.Set_ItemIndex(Value: Integer);
  270. begin
  271.   FDelphiControl.ItemIndex := Value;
  272. end;
  273.  
  274. procedure TCheckListBoxX.Set_Items(const Value: IStrings);
  275. begin
  276.   SetOleStrings(FDelphiControl.Items, Value);
  277. end;
  278.  
  279. procedure TCheckListBoxX.Set_ParentColor(Value: WordBool);
  280. begin
  281.   FDelphiControl.ParentColor := Value;
  282. end;
  283.  
  284. procedure TCheckListBoxX.Set_Sorted(Value: WordBool);
  285. begin
  286.   FDelphiControl.Sorted := Value;
  287. end;
  288.  
  289. procedure TCheckListBoxX.Set_Style(Value: TxListBoxStyle);
  290. begin
  291.   FDelphiControl.Style := TListBoxStyle(Value);
  292. end;
  293.  
  294. procedure TCheckListBoxX.Set_TabWidth(Value: Integer);
  295. begin
  296.   FDelphiControl.TabWidth := Value;
  297. end;
  298.  
  299. procedure TCheckListBoxX.Set_TopIndex(Value: Integer);
  300. begin
  301.   FDelphiControl.TopIndex := Value;
  302. end;
  303.  
  304. procedure TCheckListBoxX.Set_Visible(Value: WordBool);
  305. begin
  306.   FDelphiControl.Visible := Value;
  307. end;
  308.  
  309. procedure TCheckListBoxX.ClickCheckEvent(Sender: TObject);
  310. begin
  311.   if FEvents <> nil then FEvents.OnClickCheck;
  312. end;
  313.  
  314. procedure TCheckListBoxX.ClickEvent(Sender: TObject);
  315. begin
  316.   if FEvents <> nil then FEvents.OnClick;
  317. end;
  318.  
  319. procedure TCheckListBoxX.DblClickEvent(Sender: TObject);
  320. begin
  321.   if FEvents <> nil then FEvents.OnDblClick;
  322. end;
  323.  
  324. procedure TCheckListBoxX.KeyPressEvent(Sender: TObject; var Key: Char);
  325. var
  326.   TempKey: Smallint;
  327. begin
  328.   TempKey := Smallint(Key);
  329.   if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  330.   Key := Char(TempKey);
  331. end;
  332.  
  333. initialization
  334.   TActiveXControlFactory.Create(
  335.     ComServer,
  336.     TCheckListBoxX,
  337.     TCheckListBox,
  338.     Class_CheckListBoxX,
  339.     4,
  340.     '{5A56596A-7975-11D0-BE02-00A024D1875C}');
  341. end.
  342.